home *** CD-ROM | disk | FTP | other *** search
/ HPAVC / HPAVC CD-ROM.iso / GFXFX2.ZIP / 3D_FCUBE.PAS < prev    next >
Pascal/Delphi Source File  |  1995-02-14  |  3KB  |  105 lines
  1.  
  2. program fired_cube; { 3D_FCUBE.PAS }
  3. { 3D-rotating cube on fire, by Bas van Gaalen,
  4.   slow on a 386, terrible on a 286, great on a 486+ }
  5. uses u_vga,u_pal,u_3d,u_kb;
  6. const
  7.   fpoly=1;
  8.   nofpoints=8;
  9.   nofplanes=6;
  10.   points:array[1..nofpoints,0..2] of integer=(
  11.     (-20,-20,-20),(-20,-20,20),(20,-20,20),(20,-20,-20),
  12.     (-20, 20,-20),(-20, 20,20),(20, 20,20),(20, 20,-20));
  13.   planes:array[1..nofplanes,0..3] of byte=(
  14.     (1,5,6,2),(1,4,8,5),(1,2,3,4),(5,6,7,8),(8,7,3,4),(2,3,7,6));
  15. var virscr:pointer;
  16.  
  17. procedure fadeout; assembler;
  18. asm
  19.   les di,virscr
  20.   xor cx,cx
  21.  @yloop:
  22.   mov ax,320
  23.   mul cx
  24.   mov bx,65
  25.  @xloop:
  26.   push ax
  27.   add ax,bx
  28.   mov di,ax
  29.   mov si,ax
  30.   xor ah,ah
  31.   xor dx,dx
  32.   mov al,es:[si]
  33.   add dx,ax
  34.   mov al,es:[si+318]
  35.   add dx,ax
  36.   mov al,es:[si+640]
  37.   add dx,ax
  38.   mov al,es:[si+321]
  39.   add dx,ax
  40.   shr dx,2
  41.   jz @skip
  42.   dec dl
  43.  @skip:
  44.   mov [es:di],dl
  45.   pop ax
  46.   inc bx
  47.   cmp bx,270
  48.   jne @xloop
  49.   inc cx
  50.   cmp cx,175
  51.   jne @yloop
  52. end;
  53.  
  54. procedure rotate_cube;
  55. const xst=2; yst=3; zst=-2;
  56. var
  57.   xp,yp,z:array[1..nofpoints] of integer;
  58.   x,y:integer;
  59.   n,phix,phiy,phiz:byte;
  60. begin
  61.   phix:=0; phiy:=0; phiz:=0;
  62.   fillchar(xp,sizeof(xp),0);
  63.   fillchar(yp,sizeof(yp),0);
  64.   fillchar(z,sizeof(z),0);
  65.   destenation:=virscr;
  66.   repeat
  67.     {vretrace;}
  68.     setborder(250);
  69.     for n:=1 to nofpoints do begin
  70.       x:=points[n,0]; y:=points[n,1]; z[n]:=points[n,2];
  71.       rotate(x,y,z[n],phix,phiy,phiz);
  72.       conv3dto2d(xp[n],yp[n],x,y,z[n]);
  73.       inc(xp[n],160); inc(yp[n],100);
  74.     end;
  75.     for n:=1 to nofplanes do begin
  76.       polyz[n]:=(z[planes[n,0]]+z[planes[n,1]]+z[planes[n,2]]+z[planes[n,3]]) div 4;
  77.       pind[n]:=n;
  78.     end;
  79.     quicksort(nofplanes);
  80.     for n:=fpoly to nofplanes do
  81.       polygon(xp[planes[pind[n],0]],yp[planes[pind[n],0]],
  82.               xp[planes[pind[n],1]],yp[planes[pind[n],1]],
  83.               xp[planes[pind[n],2]],yp[planes[pind[n],2]],
  84.               xp[planes[pind[n],3]],yp[planes[pind[n],3]],
  85.               ctab[phix] div 2,stab[phix] div 3,2*polyz[n]+200);
  86.     inc(phix,xst); inc(phiy,yst); inc(phiz,zst);
  87.     fadeout;
  88.     flip(virscr,ptr(u_vidseg,0),320*200);
  89.     setborder(0);
  90.   until keypressed;
  91. end;
  92.  
  93. var i:word;
  94. begin
  95.   setvideo($13);
  96.   getmem(virscr,320*203); cls(virscr,320*200);
  97.   for i:=0 to 63 do setrgb(i,0,0,0);
  98.   for i:=0 to 63 do setrgb(64+i,0,0,i shr 1);
  99.   for i:=0 to 63 do setrgb(128+i,i,i shr 1,31-i shr 1);
  100.   for i:=0 to 63 do setrgb(192+i,63,32+i shr 1,0);
  101.   rotate_cube;
  102.   freemem(virscr,320*203);
  103.   setvideo(u_lm);
  104. end.
  105.